perm filename PRESCN.F4[MSS,LCS] blob
sn#133830 filedate 1974-12-04 generic text, type T, neo UTF8
00100 SUBROUTINE PRESCN
00200 C THIS SORTS OUT NEW INPUT FORMAT - CREATES OLD STYLE.
00300 DIMENSION IR(1)
00400 COMMON/ALF/INP(72),M/XRN/RN(4000)
00500 EQUIVALENCE (IR,RN(2001))
00600 C CHECK THIS EQUIV.↑↑↑↑
00605 100 IF(ISM)5,55,555
00607 C -1=PROCESS SOME MORE, 0=1ST TIME, 1=PUT OUT RHYTH
00610 55 JX=0
00900 5 K=0
01000 J=0
01100 I=JX
01150 JX=JX+72
01200 1 K=K+1
01400 M=INP(K)
01410 15 IF(M.EQ.' '.OR.M.EQ.',')GO TO 1
01420 C REMOVE BLANKS AND COMMAS
01490 JN=0
01500 IF(M.GE.'0'.AND.M.LE.'9')GO TO 2
01600 MM=INP(K+1)
01700 3 IF((M.GE.'A'.AND.M.LE.'G'.AND.MM.NE.'L'.AND.MM.NE.'A').OR.
01800 1 M.EQ.'P'.OR.M.EQ.'O')GO TO 8
01900 C FINDS NOTES, PROX., AND ORDINARY, -- NOT 'BA' OR 'AL'
02000 IF(M.NE.'R')GO TO 9
02100 IF(MM.EQ.'E')JN=1
02200 C CATCHES 'R' 'RI' 'REP'
02400 GO TO 8
02440 9 IF(M.EQ.'/'.OR.M.EQ.';'.OR.M.EQ.'*'.OR.M.EQ.':')GO TO 8
02500 JN=-1
02600 8 J=J+1
02700 INP(J)=M
02760 IF(M.EQ.'X')JN=1
02780 C PICKS UP 4X ETC. FOR BOTH NOTES AND RHYTH.
02800 IF(JN.LE.0)GO TO 13
02900 C PUTS 'REP' INTO RHYTH ALSO
02910 I=I+1
02920 IR(I)=M
03100 13 IF(M.EQ.'/'.OR.M.EQ.';'.OR.M.EQ.'*')GO TO 4
03200 K=K+1
03300 M=INP(K)
03400 GO TO 8
03500
03600 4 IF(JN.NE.0)GO TO 7
03700 I=I+1
03800 IR(I)=M
03900 7 IF(M.EQ.'/')GO TO 1
04000 IF(M.EQ.';')GO TO 11
04100 IF(M.EQ.'*')GO TO 6
04200
04300 2 I=I+1
04400 IR(I)=M
04500 K=K+1
04600 M=INP(K)
04710 IF(M.EQ.'.'.OR.(M.GE.'0'.AND.M.LE.'9'))GO TO 2
04715 C NO BLANK NEEDED AFTER RHYTH.( /4.AS3/8/ ETC.)
04720 GO TO 15
04900
05000 11 IF(IR(I).NE.';')IR(I)=';'
05100 ISM=-1
05120 RETURN
05140 C WE'LL COME BACK FOR MORE.
05160
05300 6 IF(IR(I).NE.'*')IR(I)='*'
05800 JX=0
05900 ISM=1
06000 C AFTER THIS WE USE RHYTJ DATA.
06100 RETURN
06200
06300 555 DO 12 K=1,72
06400 M=IR(K+JX)
06500 INP(K)=M
06510 IF(M.EQ.';')GO TO 10
06520 C MORE THAN ONE LINE
06530 12 IF(M.EQ.'*')GO TO 14
06540 10 JX=JX+72
06550 C MOVE TO THE NEXT 'LINE'
06560 RETURN
06570 14 ISM=0
06600 END